
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Prototype Definitions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|(defproto homals-proto '(data n m z y d-m  
                         k-j-list row-ind-list col-ind-list
                         dlist p active-categories active-variables 
                         sample-row-ind-list sample-col-ind-list
                         weights weights-samp dlist-samp z-list
                         variable-labels object-labels category-labels
                         output-file dialog eps-0 eps-1)() mv-model-object-proto)|# ;PV modified this to inherit from mv-model-object-proto

(defproto homals-dialog-proto '(homals-parent dialog-items plot-dialog) 
                                nil dialog-proto)

(defproto homals-plot-dialog-proto '(showing) 
                                     nil homals-dialog-proto)

(defproto homals-plot-proto '(plot-parent zoom plot-name overlay-list)
                              nil graph-proto)

(defproto homals-2d-plot-proto nil nil 
                              (list scatterplot-proto homals-plot-proto))

(defproto homals-3d-plot-proto nil nil 
                               (list spin-proto homals-plot-proto))

(defproto homals-list-item-proto '(last-click) nil list-item-proto)

(defproto plot-route-proto '(homals-parent plot dims))

(defproto star-plot-proto nil nil plot-route-proto)
(defproto score-plot-proto nil nil plot-route-proto)
(defproto category-plot-proto nil nil plot-route-proto)
(defproto category-object-plot-proto nil nil plot-route-proto)
(defproto combined-category-plot-proto nil nil plot-route-proto)
(defproto discrimination-plot-proto nil nil plot-route-proto)
(defproto transformation-plot-proto nil nil plot-route-proto)

;(load "core")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;   Lines Overlay Prototype
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defproto lines-overlay-proto nil nil graph-overlay-proto)

(defmeth lines-overlay-proto :redraw ()
 (let* (
       (graph (send self :graph))
       (lines (send graph :lines))
       (ht (send graph :text-ascent))
      )
   (send self :bitmap lines)
   (send graph :draw-string "Draw" 25 (+ 10 (* 7 ht)))
   (send graph :draw-string "Lines" 25 (+ 10 (* 8 ht)))
 )
)

(defmeth lines-overlay-proto :bitmap (lines)
 (let* ((check-bitmap (check))
        (blank-bitmap (empty))
        (graph (send self :graph))
        (ht (send graph :text-ascent)))
    (send graph :draw-bitmap (if lines check-bitmap blank-bitmap)
                          10 (+ 10 (* 7 ht)))))


(defmeth lines-overlay-proto :do-click (x y m1 m2)
 (let* (
        (graph (send self :graph))
        (plot-parent (send graph :plot-parent))
        (lines (send graph :lines))
        (ht (send graph :text-ascent))
        (zoom (send graph :zoom))
       )
  (when (and (< 10 x 20) (< (+ 10 (* 7 ht)) y (+ 10 (* 8 ht))))
        (if lines
            (progn
              (send graph :clear-lines)
              (send self :bitmap nil))
            (progn
              (send graph :clear-lines)
              (send plot-parent :make-lines (send graph :points-showing))
              (send graph :redraw)
              (send self :bitmap t)))
        (unless zoom (send plot-parent :selected-points))
        (send graph :lines (not lines)))))
          

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Zoom Overlay Prototype
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defproto zoom-overlay-proto nil nil graph-overlay-proto)

(defmeth zoom-overlay-proto :redraw ()
 (let* (
       (graph (send self :graph))
       (zoom (send graph :zoom))
       (ht (send graph :text-ascent))
      )
   (send self :bitmap zoom)
   (send graph :draw-string "Zoom" 25 (+ 10 ht))
   (send graph :draw-string "Out" 25 (+ 10 (* 2 ht)))
   (send graph :draw-string "Zoom" 25 (+ 10 (* 4 ht)))
   (send graph :draw-string "In" 25 (+ 10 (* 5 ht)))
 )
)


(defmeth zoom-overlay-proto :do-click (x y m1 m2)
 (let* (
        (graph (send self :graph))
        (plot-parent (send graph :plot-parent))
        (zoom (send graph :zoom))
        (ht (send graph :text-ascent))
        (lines (send graph :lines))
       )
  (cond ((and (< 10 x 20) (< (+ 10 ht) y (+ 10 (* 2 ht))) zoom)
          (send graph :zoom nil)
          (send graph :mouse-mode 'newselecting)
          (send plot-parent :cleanup)
          (send graph :show-all-points)
          (if lines (send plot-parent :make-lines))
          (send plot-parent :selected-points)
          (send self :bitmap nil))
        ((and (< 10 x 20) (< (+ 10 (* 4 ht)) y (+ 10 (* 5 ht))) (not zoom))
          (send plot-parent :selected-points)
          (send graph :zoom t)
          (send self :bitmap t)
          (send plot-parent :cleanup)
          (send graph :mouse-mode 'zoom)))))
 

(defmeth zoom-overlay-proto :bitmap (zoom)
 (let* ((check-bitmap (bullet))
        (blank-bitmap (empty))
        (graph (send self :graph))
        (ht (send graph :text-ascent)))
    (send graph :draw-bitmap (if zoom blank-bitmap check-bitmap) 10 (+ 10 ht))
    (send graph :draw-bitmap (if zoom check-bitmap blank-bitmap) 
                          10 (+ 10 (* 4 ht)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Zooming and Selecting Mouse Mode Action Methods
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth homals-plot-proto :get-zoom-points (x y m1 m2)
 (let* ((plot-parent (send self :plot-parent))
        (coords (send self :draw-box x y))
        (pts (send self :points-in-rect 
                        (if (< x (first coords)) x (first coords))
                        (if (< y (second coords)) y (second coords))
                        (abs (- x (first coords)))
                        (abs (- y (second coords)))))
        (pts-showing (send self :points-showing))
        (lines (send self :lines)))
    (when (and pts (not (= (length pts) (length pts-showing))))
      (send self :point-showing 
         (sort-data (set-difference pts-showing pts))
         (repeat nil (- (length pts-showing) (length pts))))
      (if lines 
        (progn
          (send self :clear-lines)
          (send self :adjust-to-data)
          (send plot-parent :make-lines (send self :points-showing))
          (send self :redraw))
        (send self :adjust-to-data)))))

        
(defmeth homals-plot-proto :newselect (x y m1 m2)
  (let ((plot-parent (send self :plot-parent))
        (margin (send self :margin)))
   (when (and (< (elt margin 0) x)
              (< (elt margin 1) y))
     (send self :unselect-all-points)
     (send plot-parent :cleanup)
     (let ((cl (send self :click-range)))
       (send self :adjust-points-in-rect
              (floor (- x (/ (first cl) 2))) (floor (- y (/ (second cl) 2)))
              (first cl) (second cl) 'selected))
     (let ((coords (send self :draw-box x y)))
       (when (and (not (= x (first coords))) (not (= y (second coords))))
         (send self :adjust-points-in-rect
                        (if (< x (first coords)) x (first coords))
                        (if (< y (second coords)) y (second coords))
                        (abs (- x (first coords)))
                        (abs (- y (second coords))) 'selected))))))

(defmeth homals-plot-proto :draw-box (x y)
 (let ((newx x)
       (newy y))
 (send self :draw-mode 'xor)
 (send self :while-button-down #'(lambda (x1 y1)
                      (send self :draw-box-lines x y x1 y1)
                      (send self :draw-box-lines x y newx newy)
                      (setf newx x1)
                      (setf newy y1)))
 (send self :draw-box-lines x y newx newy)
 (send self :draw-mode 'normal)
 (list newx newy)))

(defmeth homals-plot-proto :draw-box-lines (x y x1 y1)
  (send self :draw-line x y x y1)
  (send self :draw-line x y x1 y)
  (send self :draw-line x y1 x1 y1)
  (send self :draw-line x1 y1 x1 y)
)



;;  Redraw Methods to Make Windows Plots Happy

(defmeth homals-2d-plot-proto :redraw ()
 (send self :redraw-background)
 (send self :redraw-content)
 (send self :redraw-overlays)
)

(defmeth homals-3d-plot-proto :redraw ()
 (send self :redraw-background)
 (send self :redraw-content)
 (send self :redraw-overlays)
)


;; Setup Methods.  Put dimension specific setup calls in the corresponding
;; dimension method.  Put common setup calls in the homals-plot-proto setup.

(defmeth homals-2d-plot-proto :setup (dims plot-parent)
 (let ((wid (send self :text-width "Zoom")))
   (send self :back-color 'white)
   (send self :draw-color 'black)
   (send self :margin (* 2 wid) 0 0 0)
   (call-next-method dims plot-parent)
   self))

(defmeth homals-3d-plot-proto :setup (dims plot-parent)
 (let ((wid (send self :text-width "Zoom")))
   (send self :back-color 'black)
   (send self :draw-color 'white)
   (send self :margin (* 2 wid) 0 0 25)
   (call-next-method dims plot-parent)
   self))


(defmeth homals-plot-proto :setup (dims plot-parent)
 (let ((wid (send self :text-width "Zoom"))
       (zoom-overlay (send zoom-overlay-proto :new))
       (lines-overlay (send lines-overlay-proto :new)))
  (send self :add-slot 'lines t)
  (send self :plot-parent plot-parent)
  (send self :title (send self :plot-name))
  (send self :showing-labels t)
  (send self :variable-label (iseq (length dims)) (make-dim-labels dims))
  (send self :add-mouse-mode 'newselecting
                :title "New Selecting" :cursor 'arrow :click :newselect)
  (send self :add-mouse-mode 'zoom
                :title "Zooming" :cursor 'finger :click :get-zoom-points)
  (send self :add-overlay zoom-overlay)
  (if (kind-of-p plot-parent score-plot-proto)
       (send self :overlay-list (list zoom-overlay))
       (progn
        (send self :add-overlay lines-overlay)
        (send self :overlay-list (list zoom-overlay lines-overlay))))
  (send self :mouse-mode 'newselecting)
  (send self :start-buffering)
  (send plot-parent :make-points)
  (send plot-parent :make-point-labels)
  (send plot-parent :selected-points)
  (send plot-parent :make-lines)
  (send self :adjust-to-data)
  (send self :buffer-to-screen)
))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  :isnew methods
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|(defmeth homals-proto :isnew ()
  (let ((homals-dialog (send homals-dialog-proto :new self)))
   (send self :dialog homals-dialog)))|#

(defmeth homals-dialog-proto :isnew (homals-parent)
  (send self :homals-parent homals-parent)
  (send self :add-read-data)
  (send self :add-names-items)
  (send self :add-compute)
  (send self :add-converge)
  (send self :add-start-plot)
  (send self :add-output)
  (call-next-method (slot-value 'dialog-items)
                    :title "Homals Dialog"))

(defmeth homals-plot-dialog-proto :isnew (homals-parent)
  (send self :homals-parent homals-parent)
  (send self :add-plot-items)
  (call-method dialog-proto :isnew (slot-value 'dialog-items)
                            :title "Plot Dialog"
                            :go-away nil))

(defmeth homals-proto :initialize-slots ()
 (send self :z nil)
 (send self :m nil)
 (send self :n nil)
 (send self :eps-0 nil)
 (send self :eps-1 nil)
 (send self :active-homals-variables nil)
 (send self :category-labels nil)
 (send self :variable-labels nil)
 (send self :object-labels nil))


(defmeth homals-dialog-proto :close ()
 (let ((plot-dialog (send self :plot-dialog)))
   (send plot-dialog :dispose)
   (call-next-method)))

